pacman::p_load("tidyverse", "here", "glue", "colorspace", "gsheet", "labelled", "sf", "pdftools")
## csv mit nur Wahlkreisen, für Tile Map
#write_csv(dat_erst_winneronly_dw %>% dplyr::select(Wahlkreisname), here::here("data", "wk.csv"))
## Grid Preparation für Labels und Bundesländer
grid <-
read_csv(here::here("data", "wk_grid_raw.csv")) %>%
mutate(
id = str_sub(Wahlkreisname, 1, 3),
id_num = as.numeric(id),
wk = str_sub(Wahlkreisname, 5, nchar(Wahlkreisname)),
land = case_when(
id_num %in% 1:11 ~ "Schleswig-Holstein",
id_num %in% 12:17 ~ "Mecklenburg-Vorpommern",
id_num %in% 18:23 ~ "Hamburg",
id_num %in% 24:53 ~ "Niedersachsen",
id_num %in% 54:55 ~ "Bremen",
id_num %in% 56:65 ~ "Brandenburg",
id_num %in% 66:74 ~ "Sachsen-Anhalt",
id_num %in% 75:86 ~ "Berlin",
id_num %in% 87:150 ~ "Nordrhein-Westfalen",
id_num %in% 151:166 ~ "Sachsen",
id_num %in% 167:188 ~ "Hessen",
id_num %in% 189:196 ~ "Thüringen",
id_num %in% 197:211 ~ "Rheinland-Pfalz",
id_num %in% 212:257 ~ "Bayern",
id_num %in% 258:295 ~ "Baden-Württemberg",
id_num %in% 296:299 ~ "Saarland"
)
)
-- Column specification ----------------------------------------------
cols(
Wahlkreisname = col_character(),
row = col_double(),
col = col_double()
)
write_csv(grid, here::here("data", "de_constituencies_grid.csv"))
grid <- read_csv(here::here("data", "de_constituencies_grid.csv"))
-- Column specification ----------------------------------------------
cols(
Wahlkreisname = col_character(),
row = col_double(),
col = col_double(),
id = col_character(),
id_num = col_double(),
wk = col_character(),
land = col_character()
)
Source: Kayser, Leininger, Murr & Stötzer (2021) Citizens’ Forecast for the 2021 German National Election https://aleininger.eu/citizens_forecast2021/
sheet_url <- "https://docs.google.com/spreadsheets/d/1xOg9kNRMfmUXoJAYNp7R93UHfPlVus-2VV-i-Rdx1Uc/edit#gid=0"
dat_erst <- gsheet2tbl(sheet_url)
#dat_erst <- read_csv(here::here("data", "Buerger_innenvorhersage 2021 - Prognose.csv"))
#' t-Test auf Basis von Mittelwert und Standardabweichung
t_test_from_summary <- function(m1, m2, sd1, sd2, n1, n2, ...) {
group1 <- scale(1:n1)*sd1 + m1
group2 <- scale(1:n2)*sd2 + m2
t.test(group1, group2, ...)
}
dat_erst_ttest <- dat_erst %>%
mutate(Stimmenanteil_Mean = ifelse(Stimmenanteil_Mean > 1000,
Stimmenanteil_Mean / 1000,
Stimmenanteil_Mean)) %>%
group_by(wkr) %>%
slice_max(order_by = Stimmenanteil_Mean, n = 2, with_ties = FALSE) %>%
mutate(rank = rank(-Stimmenanteil_Mean, ties.method = "first")) %>%
ungroup() %>%
select(wkr, rank, Stimmenanteil_Mean, Stimmenanteil_SD, obs) %>%
pivot_wider(id_cols = wkr,
names_from = "rank",
values_from = c("Stimmenanteil_Mean", "Stimmenanteil_SD", "obs")) %>%
mutate(t_test = pmap(list(m1 = Stimmenanteil_Mean_1, m2 = Stimmenanteil_Mean_2,
sd1 = Stimmenanteil_SD_1, sd2 = Stimmenanteil_SD_2,
n1 = obs_1, n2 = obs_2, alternative = "greater"),
t_test_from_summary),
t = map_dbl(t_test, "statistic"),
p_value = map_dbl(t_test, "p.value"))
dat_erst_winneronly_dw <-
dat_erst %>%
group_by(wkr) %>%
dplyr::select(wkr, Wahlkreisname, party, kandidate_name, obs, Gewinner_share) %>%
mutate(Gewinner_share = ifelse(Gewinner_share > 100, Gewinner_share / 1000, Gewinner_share),
rank = rank(Gewinner_share, ties.method = "first"),
name = to_character(wkr),
Gewinner_share = round(Gewinner_share*100)) %>%
filter(rank > 5) %>%
mutate(party = as.character(party)) %>%
unite(val, party, Gewinner_share, kandidate_name) %>%
spread(rank,val) %>%
separate("7",into = c("first-place-party", "first-place-votes", "winner"),"_") %>%
separate("6",into = c("second-place-party", "second-place-votes", "second"),"_") %>%
mutate(outcome = ifelse(`first-place-votes` == `second-place-votes`, 'Kopf-an-Kopf', `first-place-party`)) %>%
relocate("outcome", "first-place-party", "first-place-votes", "winner", .before = "second-place-party") %>%
ungroup() %>%
# add t-test statistic
inner_join(dat_erst_ttest, by = "wkr")
dat_winneronly_grid <-
dat_erst_winneronly_dw %>%
left_join(grid) %>%
mutate(
outcome_agg = ifelse(outcome %in% c("CDU", "CSU"), "CDU/CSU", outcome),
diff = as.numeric(`first-place-votes`) - as.numeric(`second-place-votes`),
outcome_agg = factor(outcome_agg, levels = c("CDU/CSU", "SPD", "Grüne", "Linke", "AfD", "Kopf-an-Kopf"))
)
Joining, by = "Wahlkreisname"
theme_set(theme_void(base_size = 16, base_family = "Editorial New")) #Editorial New, Noto Serif
theme_update(legend.margin = margin(0, 0, 0, 25),
legend.text = element_text(margin = margin(5, 0, 5, 0)),
plot.title = element_text(hjust = .5, face = "bold",
lineheight = 1.1, margin = margin(t = 10, b = 20)),
plot.subtitle = element_text(hjust = .5, color = "grey40", size = 15,
margin = margin(t = -8, b = 18)),
plot.title.position = "plot",
plot.caption = element_text(hjust = 0, color = "grey40",
lineheight = 1.3,
size = 9, margin = margin(20, 0, 5, 0)),
plot.caption.position = "plot",
plot.margin = margin(10, 0, 10, 0))
# Party colors
party_colors <- c("CDU/CSU" = "grey9",
#"CSU" = "grey18",
"SPD" = "#ca0002", ## "#E3000F", a bit darker now to make it work with CVD
"Grüne" = rgb(100, 161, 45, maxColorValue = 255),
#"FDP" = darken("#ffed00", 0.1),
"Linke" = "purple",
"AfD" = rgb(0, 158, 224, maxColorValue = 255))
caption_de <- "Grafik: Cédric Scherer & Ansgar Wolsing\nDaten: Kayser, Leininger, Murr & Stötzer (2021) Citizens’ Forecast for the 2021 German National Election (aleininger.eu/citizens_forecast2021)\nDie Karte basiert auf einer Befragung einer nicht-repräsentativen Stichprobe von Bürger*innen in allen 299 Wahlkreisen zu den Erfolgsaussichten des*der Kandidierenden*in."
title_de <- "Bürger*innenvorhersage der Direktmandatsgewinner*innen\nin den Wahlkreisen zur Bundestagswahl 2021"
caption_en <- "Graphic: Cédric Scherer & Ansgar Wolsing\nData: Kayser, Leininger, Murr & Stötzer (2021) Citizens’ Forecast for the 2021 German National Election (aleininger.eu/citizens_forecast2021)\nThe map is based on a survey of a non-representative sample of citizens in all 299 Bundestag constituencies on the candidates' chances of success."
title_en <- "Citizens’ Forecast of Direct Mandate Winners in\nthe Constituencies for the 2021 Federal Election"
parties_en <- c("CDU/CSU", "SPD", "The Greens", "The Left", "AFD", "Too close to call")
set.seed(1234567890)
pal <- sample(ggsci::pal_simpsons()(16))
g <-
ggplot(grid, aes(col, row, color = land, fill = land)) +
geom_tile(size = 3, color = "#212121") +
geom_tile(size = .01) +
coord_fixed() +
scale_x_continuous(expand = c(.01, .01), limits = c(-.5, max(grid$col) + .5)) +
scale_y_reverse(expand = c(.03, .03)) +
scale_color_manual(values = pal, name = NULL) +
scale_fill_manual(values = pal, name = NULL) +
theme(plot.margin = margin(15, 10, 15, 0))
## Deutsche Version
g + labs(title = "Tile Grid Karte der Wahlkreise Deutschland", caption = "Grafik: Cédric Scherer & Ansgar Wolsing")
ggsave(here::here("plots", "grid_laender_de.pdf"), width = 10, height = 10, device = cairo_pdf)
## Englische Version
g + labs(title = "Tile Grid Map of Germany's Constituencies", caption = "Design: Cédric Scherer & Ansgar Wolsing")
ggsave(here::here("plots", "grid_laender_en.pdf"), width = 10, height = 10, device = cairo_pdf)
g <- ggplot(dat_winneronly_grid, aes(col, row)) +
geom_point(aes(color = outcome_agg), size = 12, shape = 15) +
coord_fixed() +
scale_x_continuous(limits = c(-.5, max(grid$col) + 2)) +
scale_y_reverse(expand = c(.03, .03)) +
scale_color_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")),
name = NULL) +
guides(color = guide_legend(override.aes = list(size = 6))) +
theme(legend.position = c(.87, .25))
## Deutsche Version
g + labs(title = title_de, caption = caption_de)
ggsave(here::here("plots", "grid_map_de.pdf"), width = 10, height = 13, device = cairo_pdf)
## Englische Version
g + labs(title = title_en, caption = caption_en) +
scale_color_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")),
name = NULL, labels = parties_en)
Scale for 'colour' is already present. Adding another scale for
'colour', which will replace the existing scale.
ggsave(here::here("plots", "grid_map_en.pdf"), width = 10, height = 13, device = cairo_pdf)
g <-
ggplot(dat_winneronly_grid, aes(col, row)) +
geom_point(
aes(fill = outcome_agg),
size = 12, shape = 22, stroke = 2, alpha = .5, color = "transparent"
) +
geom_point(
aes(color = outcome_agg),
size = 12, shape = 22, stroke = 2, fill = "transparent"
) +
coord_fixed() +
scale_x_continuous(limits = c(-.5, max(grid$col) + 2)) +
scale_y_reverse(expand = c(.03, .03)) +
scale_color_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")), name = NULL) +
scale_fill_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")), name = NULL) +
guides(color = guide_legend(override.aes = list(size = 6))) +
theme(legend.position = c(.87, .25))
## Deutsche Version
g + labs(title = title_de, caption = caption_de)
ggsave(here::here("plots", "grid_map_de_v2.pdf"), width = 10, height = 13, device = cairo_pdf)
## Englische Version
g + labs(title = title_en, caption = caption_en) +
scale_color_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")),
name = NULL, labels = parties_en) +
scale_fill_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")),
name = NULL, labels = parties_en)
Scale for 'colour' is already present. Adding another scale for
'colour', which will replace the existing scale.
Scale for 'fill' is already present. Adding another scale for
'fill', which will replace the existing scale.
ggsave(here::here("plots", "grid_map_en_v2.pdf"), width = 10, height = 13, device = cairo_pdf)
g <- ggplot(dat_winneronly_grid, aes(col, row)) +
geom_point(aes(color = outcome_agg), size = 10) +
coord_fixed() +
scale_x_continuous(limits = c(-.5, max(grid$col) + 2)) +
scale_y_reverse(expand = c(.03, .03)) +
scale_color_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")),
name = NULL) +
guides(color = guide_legend(override.aes = list(size = 6))) +
theme(legend.position = c(.87, .25))
## Deutsche Version
g + labs(title = title_de, caption = caption_de)
ggsave(here::here("plots", "bubble_map_de.pdf"), width = 10, height = 13, device = cairo_pdf)
## Englische Version
g + labs(title = title_en, caption = caption_en) +
scale_color_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")),
name = NULL, labels = parties_en)
Scale for 'colour' is already present. Adding another scale for
'colour', which will replace the existing scale.
ggsave(here::here("plots", "bubble_map_en.pdf"), width = 10, height = 13, device = cairo_pdf)
g <-
ggplot(dat_winneronly_grid, aes(col, row)) +
geom_point(
aes(fill = outcome_agg),
size = 10, shape = 21, stroke = 2, alpha = .5, color = "transparent"
) +
geom_point(
aes(color = outcome_agg),
size = 10, shape = 21, stroke = 2, fill = "transparent"
) +
coord_fixed() +
scale_x_continuous(limits = c(-.5, max(grid$col) + 2)) +
scale_y_reverse(expand = c(.03, .03)) +
scale_color_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")), name = NULL) +
scale_fill_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")), name = NULL) +
guides(color = guide_legend(override.aes = list(size = 6))) +
theme(legend.position = c(.87, .25))
## Deutsche Version
g + labs(title = title_de, caption = caption_de)
ggsave(here::here("plots", "bubble_map_de_v2.pdf"), width = 10, height = 13, device = cairo_pdf)
## Englische Version
g + labs(title = title_en, caption = caption_en) +
scale_color_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")),
name = NULL, labels = parties_en) +
scale_fill_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")),
name = NULL, labels = parties_en)
Scale for 'colour' is already present. Adding another scale for
'colour', which will replace the existing scale.
Scale for 'fill' is already present. Adding another scale for
'fill', which will replace the existing scale.
ggsave(here::here("plots", "bubble_map_en_v2.pdf"), width = 10, height = 13, device = cairo_pdf)
g <-
ggplot(dat_winneronly_grid, aes(col, row)) +
geom_point(
aes(fill = outcome_agg, alpha = diff),
size = 12, shape = 22, stroke = 2, color = "transparent"
) +
geom_point(
aes(color = outcome_agg),
size = 12, shape = 22, stroke = 2, fill = "transparent"
) +
coord_fixed() +
scale_x_continuous(limits = c(-.5, max(grid$col) + 2)) +
scale_y_reverse(expand = c(.03, .03)) +
scale_color_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")), name = NULL) +
scale_fill_manual(values = c(party_colors, c("Kopf-an-Kopf" = "transparent")), name = NULL) +
scale_alpha(range = c(0, .86), guide = "none") +
guides(fill = guide_legend(override.aes = list(size = 6, alpha = .9))) +
theme(legend.position = c(.87, .25))
## Deutsche Version
g + labs(title = title_de, caption = caption_de,
subtitle = "Je intensiver die Färbung, desto größer ist der vorhergesagte Vorsprung.")
ggsave(here::here("plots", "grid_map_diff_de.pdf"), width = 10, height = 13, device = cairo_pdf)
## Englische Version
g + labs(title = title_en, caption = caption_en,
subtitle = "The more intense the coloring of the dots, the greater the predicted lead.") +
scale_color_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")),
name = NULL, labels = parties_en) +
scale_fill_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")),
name = NULL, labels = parties_en)
Scale for 'colour' is already present. Adding another scale for
'colour', which will replace the existing scale.
Scale for 'fill' is already present. Adding another scale for
'fill', which will replace the existing scale.
ggsave(here::here("plots", "grid_map_diff_en.pdf"), width = 10, height = 13, device = cairo_pdf)
g <-
ggplot(dat_winneronly_grid, aes(col, row)) +
geom_point(
aes(fill = outcome_agg, alpha = diff),
size = 9, shape = 21, stroke = 2, color = "transparent"
) +
geom_point(
aes(color = outcome_agg),
size = 9, shape = 21, stroke = 2, fill = "transparent"
) +
coord_fixed() +
scale_x_continuous(limits = c(-.5, max(grid$col) + 2)) +
scale_y_reverse(expand = c(.03, .03)) +
scale_color_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")), name = NULL) +
scale_fill_manual(values = c(party_colors, c("Kopf-an-Kopf" = "transparent")), name = NULL) +
scale_alpha(range = c(0, .86), guide = "none") +
guides(fill = guide_legend(override.aes = list(size = 6, alpha = .9))) +
theme(legend.position = c(.87, .25))
## Deutsche Version
g + labs(title = title_de, caption = caption_de,
subtitle = "Je intensiver die Färbung, desto größer ist der vorhergesagte Vorsprung.")
ggsave(here::here("plots", "bubble_map_diff_de.pdf"), width = 10, height = 13, device = cairo_pdf)
## Englische Version
g + labs(title = title_en, caption = caption_en,
subtitle = "The more intense the coloring of the dots, the greater the predicted lead.") +
scale_color_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")),
name = NULL, labels = parties_en) +
scale_fill_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")),
name = NULL, labels = parties_en)
Scale for 'colour' is already present. Adding another scale for
'colour', which will replace the existing scale.
Scale for 'fill' is already present. Adding another scale for
'fill', which will replace the existing scale.
ggsave(here::here("plots", "bubble_map_diff_en.pdf"), width = 10, height = 13, device = cairo_pdf)
g <-
ggplot(dat_winneronly_grid, aes(col, row)) +
geom_point(
aes(fill = outcome_agg,
# alpha = diff
alpha = t # Ergebnis t-Test (oder p-value stattdessen?)
),
size = 9, shape = 21, stroke = 2, color = "transparent"
) +
geom_point(
aes(color = outcome_agg),
size = 9, shape = 21, stroke = 2, fill = "transparent"
) +
coord_fixed() +
scale_x_continuous(limits = c(-.5, max(grid$col) + 2)) +
scale_y_reverse(expand = c(.03, .03)) +
scale_color_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")), name = NULL) +
scale_fill_manual(values = c(party_colors, c("Kopf-an-Kopf" = "transparent")), name = NULL) +
scale_alpha(range = c(0, .86), guide = "none") +
guides(fill = guide_legend(override.aes = list(size = 6, alpha = .9))) +
theme(legend.position = c(.87, .25))
## Deutsche Version
g + labs(title = title_de, caption = glue("{caption_de}\nDie Vorhersage der Mandatsgewinner basiert auf einem t-Test auf Basis von Mittelwert und Standardabweichung."),
subtitle = "Je intensiver die Färbung, desto größer ist der vorhergesagte Vorsprung.")
ggsave(here::here("plots", "bubble_map_t_test_de.pdf"), width = 10, height = 13, device = cairo_pdf)
## Englische Version
g + labs(title = title_en, caption = glue("{caption_en}\nThe prediction of mandate winners is based on a t-test based on mean and standard deviation."),
subtitle = "The more intense the coloring, the greater the predicted lead.") +
scale_color_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")),
name = NULL, labels = parties_en) +
scale_fill_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")),
name = NULL, labels = parties_en)
Scale for 'colour' is already present. Adding another scale for
'colour', which will replace the existing scale.
Scale for 'fill' is already present. Adding another scale for
'fill', which will replace the existing scale.
ggsave(here::here("plots", "bubble_map_t_test_en.pdf"), width = 10, height = 13, device = cairo_pdf)
Leider nicht so schön und sinnvoll wie erhofft.
ggplot(dat_winneronly_grid, aes(col, row)) +
ggforce::geom_mark_hull(
aes(group = land),
color = "white",
expand = unit(0, "mm")
) +
geom_point(aes(color = outcome_agg), size = 7) +
coord_fixed() +
scale_x_continuous(limits = c(-.5, max(grid$col) + 2)) +
scale_y_reverse(expand = c(.03, .03)) +
scale_color_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")),
name = NULL) +
guides(color = guide_legend(override.aes = list(size = 6))) +
theme(legend.position = c(.87, .25),
plot.background = element_rect(color = "grey67", fill = "grey67")) +
labs(title = title_de, caption = caption_de)
ggsave(here::here("plots", "bubble_map_states.pdf"), width = 10, height = 13, device = cairo_pdf)
Weder effektiv noch schön.
# Größenkategorien für Bundesländer
bland_group_mapping <- c(
"Schleswig-Holstein" = "A",
"Mecklenburg-Vorpommern" = "B",
"Hamburg" = "D",
"Niedersachsen" = "C",
"Bremen" = "E",
"Brandenburg" = "A",
"Sachsen-Anhalt" = "D",
"Berlin" = "A",
"Nordrhein-Westfalen" = "D",
"Sachsen" = "A",
"Hessen" = "E",
"Thüringen" = "B",
"Rheinland-Pfalz" = "A",
"Bayern" = "D",
"Baden-Württemberg" = "B",
"Saarland" = "A"
)
dat_winneronly_grid %>%
mutate(mark_group = bland_group_mapping[land],
mark_shape = case_when(
mark_group == "A" ~ 21,
mark_group == "B" ~ 22,
mark_group == "C" ~ 23,
mark_group == "D" ~ 24,
mark_group == "E" ~ 25,
)) %>%
ggplot(aes(col, row)) +
geom_point(
aes(fill = outcome_agg, alpha = diff, size = mark_group),
# size = 9,
shape = 21,
stroke = 2, color = "transparent"
) +
geom_point(
aes(color = outcome_agg, size = mark_group),
# size = 9,
shape = 21,
stroke = 2, fill = "transparent"
) +
coord_fixed() +
scale_x_continuous(limits = c(-.5, max(grid$col) + 2)) +
scale_y_reverse(expand = c(.03, .03)) +
scale_color_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")), name = NULL) +
scale_fill_manual(values = c(party_colors, c("Kopf-an-Kopf" = "transparent")), name = NULL) +
scale_alpha(range = c(0, .86), guide = "none") +
scale_size_discrete(range = c(7, 11)) +
# scale_shape_identity() +
guides(fill = guide_legend(override.aes = list(size = 6, alpha = .9)),
size = "none") +
theme(legend.position = c(.87, .25)) +
labs(title = title_de, caption = caption_de,
subtitle = "Je intensiver die Färbung, desto größer ist der vorhergesagte Vorsprung.")
ggsave(here::here("plots", "bubble_map_diff_bland_mark.pdf"), width = 10, height = 13, device = cairo_pdf)
constituencies_to_highlight <- c(
18, # Hamburg-Mitte
75, # Berlin-Mitte
93, # Köln I
220 # München-West/Mitte
)
df_constituencies_highlight <- dat_winneronly_grid %>%
filter(wkr %in% constituencies_to_highlight) %>%
mutate(name_short = str_extract(Wahlkreisname, "[a-zA-ZäöüÄÖÜ]+")) %>%
select(name_short, name, col, row)
ggplot(dat_winneronly_grid, aes(col, row)) +
geom_point(
aes(fill = outcome_agg, alpha = diff),
size = 9, shape = 21, stroke = 2, color = "transparent"
) +
geom_point(
aes(color = outcome_agg),
size = 9, shape = 21, stroke = 2, fill = "transparent"
) +
geom_label(data = df_constituencies_highlight,
aes(label = name_short),
col = "grey99",
fill = "grey10", alpha = 0.4, family = "Roboto",
label.size = 0,
fontface = "bold", size = 6,
hjust = 0.5) +
coord_fixed() +
scale_x_continuous(limits = c(-.5, max(grid$col) + 2)) +
scale_y_reverse(expand = c(.03, .03)) +
scale_color_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")), name = NULL) +
scale_fill_manual(values = c(party_colors, c("Kopf-an-Kopf" = "transparent")), name = NULL) +
scale_alpha(range = c(0, .86), guide = "none") +
guides(fill = guide_legend(override.aes = list(size = 6, alpha = .9))) +
theme(legend.position = c(.87, .25)) +
labs(title = title_de, caption = caption_de,
subtitle = "Je intensiver die Färbung, desto größer ist der vorhergesagte Vorsprung.")
ggsave(here::here("plots", "bubble_map_diff_location_highlights.pdf"), width = 10, height = 13, device = cairo_pdf)
labels <- dat_winneronly_grid %>%
filter(str_detect(wk, "München|Köln") | land %in% c("Berlin", "Hamburg")) %>%
filter(wk != "München-Land") %>%
mutate(label = case_when(
str_detect(wk, "München") ~ "München",
str_detect(wk, "Köln") ~ "Köln",
TRUE ~ land
))
ggplot(dat_winneronly_grid, aes(col, row)) +
geom_tile(
data = labels,
fill = "grey60", color = "grey60"
) +
geom_point(
fill = "white", size = 9, shape = 21, stroke = 2, color = "transparent"
) +
geom_point(
aes(fill = outcome_agg, alpha = diff),
size = 9, shape = 21, stroke = 2, color = "transparent"
) +
geom_point(
aes(color = outcome_agg),
size = 9, shape = 21, stroke = 2, fill = "transparent"
) +
# ggforce::geom_mark_hull(
# data = labels,
# aes(group = label),
# concavity = 0
# ) +
coord_fixed() +
scale_x_continuous(limits = c(-.5, max(grid$col) + 2)) +
scale_y_reverse(expand = c(.03, .03)) +
scale_color_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")), name = NULL) +
scale_fill_manual(values = c(party_colors, c("Kopf-an-Kopf" = "transparent")), name = NULL) +
scale_alpha(range = c(0, .86), guide = "none") +
guides(fill = guide_legend(override.aes = list(size = 6, alpha = .9))) +
theme(legend.position = c(.87, .25)) +
labs(title = title_de, caption = caption_de,
subtitle = "Je intensiver die Färbung, desto größer ist der vorhergesagte Vorsprung.")
ggsave(here::here("plots", "bubble_map_diff_location_highlights_ggforce.pdf"), width = 10, height = 13, device = cairo_pdf)
library(ggiraph)
g_interactive <- dat_winneronly_grid %>%
mutate(label = str_wrap(glue::glue("{Wahlkreisname} ({land})<br><br>Vorsprung:<br>{outcome} {diff}%"), 50)) %>%
ggplot(aes(col, row)) +
geom_point_interactive(
aes(fill = outcome_agg, alpha = diff, tooltip = label, data_id = label),
size = 9, shape = 21, stroke = 2, color = "transparent"
) +
geom_point(
aes(color = outcome_agg),
size = 9, shape = 21, stroke = 2, fill = "transparent"
) +
coord_fixed() +
scale_x_continuous(limits = c(-.5, max(grid$col) + 2)) +
scale_y_reverse(expand = c(.03, .03)) +
scale_color_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")), name = NULL) +
scale_fill_manual(values = c(party_colors, c("Kopf-an-Kopf" = "transparent")), name = NULL) +
scale_alpha(range = c(0, .86), guide = "none") +
guides(color = guide_legend(override.aes = list(size = 6))) +
labs(title = title_de, caption = caption_de)
tooltip_css <- "background-color:#515151;color:white;font-family:Roboto;padding:10px;border-radius:5px;"
girafe(ggobj = g_interactive,
width_svg = 12, height_svg = 12,
options = list(
opts_sizing(rescale = FALSE),
opts_tooltip(offx = 50, css = tooltip_css)
))
#ggsave(here::here("plots", "bubble_map_states.pdf"), width = 10, height = 13, device = cairo_pdf)
## READ GEOMETRY ==============================================
#' https://pitchinteractiveinc.github.io/tilegrams/
#' Download geometry "Germany - Constituencies" as TopoJSON
#' and place it in the data directory
filepath_topo <- here("data", "tiles.topo.json")
wk_topo <- geojsonio::topojson_read(filepath_topo)
Registered S3 method overwritten by 'geojsonsf':
method from
print.geojson geojson
wk_topo <- wk_topo %>% mutate(id = as.numeric(id))
# Merge shapes of constituencies into state-level shapes
bland_shape <- wk_topo %>%
inner_join(dat_winneronly_grid, by = c("id" = "wkr")) %>%
group_by(land) %>%
summarize(geometry = st_union(geometry))
df_constituencies_highlight_hex <- wk_topo %>%
filter(id %in% constituencies_to_highlight) %>%
mutate(geometry = st_make_valid(geometry) %>%
st_centroid(),
lon = map(geometry, 1),
lat = map(geometry, 2),
name_short = str_extract(name, "[a-zA-ZäöüÄÖÜ]+"))
g <- dat_winneronly_grid %>%
inner_join(wk_topo, by = c("wkr" = "id")) %>%
ggplot(aes(geometry = geometry)) +
geom_sf(aes(fill = outcome_agg, col = outcome_agg, alpha = diff),
size = 0.1, # col = "grey80"
) +
geom_sf_text(aes(label = id),
size = 2.5, family = "Roboto Mono") +
geom_sf(data = bland_shape,
aes(geometry = geometry,
group = land),
fill = NA, col = "grey96",
size = 2, show.legend = FALSE) +
geom_sf(aes(col = outcome_agg),
size = 0.1, fill = "transparent"
) +
# geom_sf_label(data = df_constituencies_highlight_hex,
# aes(lon, lat, label = name_short),
# col = "grey99",
# fill = "grey10", alpha = 0.4, family = "Roboto",
# label.size = 0,
# fontface = "bold", size = 6,
# hjust = 0.5) +
#scale_x_continuous(limits = c(NA, )) +
scale_y_continuous(expand = c(.01, .01)) +
scale_color_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")), name = NULL) +
scale_fill_manual(values = c(party_colors, c("Kopf-an-Kopf" = "transparent")), name = NULL) +
scale_alpha(range = c(0, .86), guide = "none") +
guides(fill = guide_legend(override.aes = list(size = 0.25, alpha = .5))) +
theme(legend.position = c(.08, .15),
legend.key.size = unit(5, "mm"))
## Deutsche Version
g + labs(title = title_de,
subtitle = "Je intensiver die Färbung, desto größer ist der vorhergesagte Vorsprung.",
caption = glue("{caption_de}\nTilegram-Geometrie: pitchinteractiveinc.github.io"))
ggsave(here::here("plots", "hexagon_map_diff_de.pdf"), width = 10, height = 13, device = cairo_pdf)
## Englische Version
g + labs(title = title_en,
subtitle = "The more intense the coloring of the dots, the greater the predicted lead.",
caption = glue("{caption_en}\nTilegram-Geometrie: pitchinteractiveinc.github.io")) +
scale_color_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")),
name = NULL, labels = parties_en) +
scale_fill_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")),
name = NULL, labels = parties_en)
Scale for 'colour' is already present. Adding another scale for
'colour', which will replace the existing scale.
Scale for 'fill' is already present. Adding another scale for
'fill', which will replace the existing scale.
ggsave(here::here("plots", "hexagon_map_diff_en.pdf"), width = 10, height = 13, device = cairo_pdf)
g <- dat_winneronly_grid %>%
inner_join(wk_topo, by = c("wkr" = "id")) %>%
ggplot(aes(geometry = geometry)) +
geom_sf(aes(fill = outcome_agg, col = outcome_agg, alpha = t),
size = 0.1, # col = "grey80"
) +
geom_sf_text(aes(label = id),
size = 2.5, family = "Roboto Mono") +
geom_sf(data = bland_shape,
aes(geometry = geometry,
group = land),
fill = NA, col = "grey96",
size = 2, show.legend = FALSE) +
geom_sf(aes(col = outcome_agg),
size = 0.1, fill = "transparent"
) +
# geom_sf_label(data = df_constituencies_highlight_hex,
# aes(lon, lat, label = name_short),
# col = "grey99",
# fill = "grey10", alpha = 0.4, family = "Roboto",
# label.size = 0,
# fontface = "bold", size = 6,
# hjust = 0.5) +
#scale_x_continuous(limits = c(NA, )) +
scale_y_continuous(expand = c(.01, .01)) +
scale_color_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")), name = NULL) +
scale_fill_manual(values = c(party_colors, c("Kopf-an-Kopf" = "transparent")), name = NULL) +
scale_alpha(range = c(0, .86), guide = "none") +
guides(fill = guide_legend(override.aes = list(size = 0.25, alpha = .5))) +
theme(legend.position = c(.08, .15),
legend.key.size = unit(5, "mm"))
## Deutsche Version
g + labs(title = title_de,
subtitle = "Je intensiver die Färbung, desto größer ist der vorhergesagte Vorsprung.",
caption = glue("{caption_de}\nTilegram-Geometrie: pitchinteractiveinc.github.io"))
ggsave(here::here("plots", "hexagon_map_t_test_de.pdf"), width = 10, height = 13, device = cairo_pdf)
## Englische Version
g + labs(title = title_en,
subtitle = "The more intense the coloring of the dots, the greater the predicted lead.",
caption = glue("{caption_en}\nTilegram-Geometrie: pitchinteractiveinc.github.io")) +
scale_color_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")),
name = NULL, labels = parties_en) +
scale_fill_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")),
name = NULL, labels = parties_en)
Scale for 'colour' is already present. Adding another scale for
'colour', which will replace the existing scale.
Scale for 'fill' is already present. Adding another scale for
'fill', which will replace the existing scale.
ggsave(here::here("plots", "hexagon_map_t_test_en.pdf"), width = 10, height = 13, device = cairo_pdf)
pdfs <- list.files(here::here(), pattern = "*.pdf", recursive = TRUE)
for(pdf in pdfs) {
pdf_convert(pdf = glue::glue("{here::here()}/{pdf}"),
filenames = glue::glue("{here::here()}/{str_remove(pdf, '.pdf')}.png"),
format = "png", dpi = 500)
}
Warning in sprintf(filenames, pages, format): 2 arguments not used
by format 'C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/
2021_Bundestagswahl/btw_tilemap/plots/bubble_map_de.png'
Converting page 1 to C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/2021_Bundestagswahl/btw_tilemap/plots/bubble_map_de.png... done!
Warning in sprintf(filenames, pages, format): 2 arguments not used
by format 'C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/
2021_Bundestagswahl/btw_tilemap/plots/bubble_map_de_v2.png'
Converting page 1 to C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/2021_Bundestagswahl/btw_tilemap/plots/bubble_map_de_v2.png... done!
Warning in sprintf(filenames, pages, format): 2 arguments not used
by format 'C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/
2021_Bundestagswahl/btw_tilemap/plots/bubble_map_diff_de.png'
Converting page 1 to C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/2021_Bundestagswahl/btw_tilemap/plots/bubble_map_diff_de.png... done!
Warning in sprintf(filenames, pages, format): 2 arguments not used
by format 'C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/
2021_Bundestagswahl/btw_tilemap/plots/bubble_map_diff_en.png'
Converting page 1 to C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/2021_Bundestagswahl/btw_tilemap/plots/bubble_map_diff_en.png... done!
Warning in sprintf(filenames, pages, format): 2 arguments not used
by format 'C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/
2021_Bundestagswahl/btw_tilemap/plots/bubble_map_en.png'
Converting page 1 to C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/2021_Bundestagswahl/btw_tilemap/plots/bubble_map_en.png... done!
Warning in sprintf(filenames, pages, format): 2 arguments not used
by format 'C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/
2021_Bundestagswahl/btw_tilemap/plots/bubble_map_en_v2.png'
Converting page 1 to C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/2021_Bundestagswahl/btw_tilemap/plots/bubble_map_en_v2.png... done!
Warning in sprintf(filenames, pages, format): 2 arguments not used
by format 'C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/
2021_Bundestagswahl/btw_tilemap/plots/bubble_map_t_test_de.png'
Converting page 1 to C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/2021_Bundestagswahl/btw_tilemap/plots/bubble_map_t_test_de.png... done!
Warning in sprintf(filenames, pages, format): 2 arguments not used
by format 'C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/
2021_Bundestagswahl/btw_tilemap/plots/bubble_map_t_test_en.png'
Converting page 1 to C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/2021_Bundestagswahl/btw_tilemap/plots/bubble_map_t_test_en.png... done!
Warning in sprintf(filenames, pages, format): 2 arguments not used
by format 'C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/
2021_Bundestagswahl/btw_tilemap/plots/grid_laender_de.png'
Converting page 1 to C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/2021_Bundestagswahl/btw_tilemap/plots/grid_laender_de.png... done!
Warning in sprintf(filenames, pages, format): 2 arguments not used
by format 'C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/
2021_Bundestagswahl/btw_tilemap/plots/grid_laender_en.png'
Converting page 1 to C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/2021_Bundestagswahl/btw_tilemap/plots/grid_laender_en.png... done!
Warning in sprintf(filenames, pages, format): 2 arguments not used
by format 'C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/
2021_Bundestagswahl/btw_tilemap/plots/grid_map_de.png'
Converting page 1 to C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/2021_Bundestagswahl/btw_tilemap/plots/grid_map_de.png... done!
Warning in sprintf(filenames, pages, format): 2 arguments not used
by format 'C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/
2021_Bundestagswahl/btw_tilemap/plots/grid_map_de_v2.png'
Converting page 1 to C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/2021_Bundestagswahl/btw_tilemap/plots/grid_map_de_v2.png... done!
Warning in sprintf(filenames, pages, format): 2 arguments not used
by format 'C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/
2021_Bundestagswahl/btw_tilemap/plots/grid_map_diff_de.png'
Converting page 1 to C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/2021_Bundestagswahl/btw_tilemap/plots/grid_map_diff_de.png... done!
Warning in sprintf(filenames, pages, format): 2 arguments not used
by format 'C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/
2021_Bundestagswahl/btw_tilemap/plots/grid_map_diff_en.png'
Converting page 1 to C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/2021_Bundestagswahl/btw_tilemap/plots/grid_map_diff_en.png... done!
Warning in sprintf(filenames, pages, format): 2 arguments not used
by format 'C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/
2021_Bundestagswahl/btw_tilemap/plots/grid_map_en.png'
Converting page 1 to C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/2021_Bundestagswahl/btw_tilemap/plots/grid_map_en.png... done!
Warning in sprintf(filenames, pages, format): 2 arguments not used
by format 'C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/
2021_Bundestagswahl/btw_tilemap/plots/grid_map_en_v2.png'
Converting page 1 to C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/2021_Bundestagswahl/btw_tilemap/plots/grid_map_en_v2.png... done!
Warning in sprintf(filenames, pages, format): 2 arguments not used
by format 'C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/
2021_Bundestagswahl/btw_tilemap/plots/hexagon_map_diff_de.png'
Converting page 1 to C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/2021_Bundestagswahl/btw_tilemap/plots/hexagon_map_diff_de.png... done!
Warning in sprintf(filenames, pages, format): 2 arguments not used
by format 'C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/
2021_Bundestagswahl/btw_tilemap/plots/hexagon_map_diff_en.png'
Converting page 1 to C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/2021_Bundestagswahl/btw_tilemap/plots/hexagon_map_diff_en.png... done!
Warning in sprintf(filenames, pages, format): 2 arguments not used
by format 'C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/
2021_Bundestagswahl/btw_tilemap/plots/hexagon_map_t_test_de.png'
Converting page 1 to C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/2021_Bundestagswahl/btw_tilemap/plots/hexagon_map_t_test_de.png... done!
Warning in sprintf(filenames, pages, format): 2 arguments not used
by format 'C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/
2021_Bundestagswahl/btw_tilemap/plots/hexagon_map_t_test_en.png'
Converting page 1 to C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/2021_Bundestagswahl/btw_tilemap/plots/hexagon_map_t_test_en.png... done!
Sys.time()
[1] "2021-09-25 21:14:18 CEST"
R version 4.1.0 (2021-05-18)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 10 x64 (build 19043)
Matrix products: default
locale:
[1] LC_COLLATE=German_Germany.1252 LC_CTYPE=German_Germany.1252
[3] LC_MONETARY=German_Germany.1252 LC_NUMERIC=C
[5] LC_TIME=German_Germany.1252
system code page: 65001
attached base packages:
[1] stats graphics grDevices utils datasets methods
[7] base
other attached packages:
[1] ggiraph_0.7.10 pdftools_3.0.1 sf_1.0-1
[4] labelled_2.8.0 gsheet_0.4.5 colorspace_2.0-2
[7] glue_1.4.2 here_1.0.1 forcats_0.5.1
[10] stringr_1.4.0 dplyr_1.0.7 purrr_0.3.4
[13] readr_1.4.0 tidyr_1.1.3 tibble_3.1.2
[16] ggplot2_3.3.5 tidyverse_1.3.1
loaded via a namespace (and not attached):
[1] fs_1.5.0 lubridate_1.7.10 httr_1.4.2
[4] rprojroot_2.0.2 ggsci_2.9 tools_4.1.0
[7] backports_1.2.1 bslib_0.2.5.1 utf8_1.2.1
[10] R6_2.5.0 KernSmooth_2.23-20 lazyeval_0.2.2
[13] rgeos_0.5-5 DBI_1.1.1 sp_1.4-5
[16] withr_2.4.2 tidyselect_1.1.1 downlit_0.2.1
[19] curl_4.3.2 compiler_4.1.0 textshaping_0.3.5
[22] cli_3.0.0 rvest_1.0.0 pacman_0.5.1
[25] geojsonsf_2.0.1 xml2_1.3.2 labeling_0.4.2
[28] sass_0.4.0 scales_1.1.1 classInt_0.4-3
[31] proxy_0.4-26 askpass_1.1 systemfonts_1.0.2
[34] digest_0.6.27 foreign_0.8-81 rmarkdown_2.9
[37] pkgconfig_2.0.3 htmltools_0.5.1.1 dbplyr_2.1.1
[40] highr_0.9 htmlwidgets_1.5.3 rlang_0.4.11
[43] readxl_1.3.1 httpcode_0.3.0 rstudioapi_0.13
[46] jquerylib_0.1.4 generics_0.1.0 farver_2.1.0
[49] jsonlite_1.7.2 distill_1.2 magrittr_2.0.1
[52] Rcpp_1.0.7 munsell_0.5.0 fansi_0.5.0
[55] lifecycle_1.0.0 stringi_1.7.3 yaml_2.2.1
[58] jqr_1.2.1 maptools_1.1-1 grid_4.1.0
[61] geojsonio_0.9.4 crayon_1.4.1 lattice_0.20-44
[64] haven_2.4.1 geojson_0.3.4 hms_1.1.0
[67] knitr_1.33 pillar_1.6.1 uuid_0.1-4
[70] crul_1.1.0 reprex_2.0.0 evaluate_0.14
[73] V8_3.4.2 qpdf_1.1 modelr_0.1.8
[76] vctrs_0.3.8 cellranger_1.1.0 gtable_0.3.0
[79] assertthat_0.2.1 xfun_0.24 broom_0.7.8
[82] e1071_1.7-7 ragg_1.1.3 class_7.3-19
[85] units_0.7-2 ellipsis_0.3.2